home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
PROGRAM
/
VS_804.ARJ
/
MISC.EXE
/
POPDICT.PRG
< prev
Wrap
Text File
|
1991-11-15
|
2KB
|
92 lines
* Filename......: PopDict.Prg
*
* Author........: Vernon E. Six, Jr.
*
* Last Update...: Fri 11-15-1991 10:57:18
*
* Notice........: Copyright (c) 1991 by Vernon E. Six, Jr.
* All Rights Reserved World Wide
*
* All Forms Of Distribution Prohibited!
*
* Dialect.......: Clipper v5.0x
#include "DBSTRUCT.CH"
FUNCTION PopDict(pc_DbfName)
*****
* Populates the _DICT*.* files for the specified DBF
*****
LOCAL a_Struct_ := {}
LOCAL n_Cntr := 0
SET(_SET_EXCLUSIVE,.F.)
VS_InitVern()
VS_NewScrn()
IF PCOUNT() <> 1
VS_Alert( {PADC("Proper Syntax: PopDict {DbfName}",50)}, {" OK "}, 3 )
RETURN(NIL)
ENDIF
VS_OpenDict("_DICTHDR")
VS_OpenDict("_DICTFLD")
IF VS_Use( pc_DbfName, .F., "TEMP", .T., .T. )
a_Struct_ := TEMP->( dbStruct() )
TEMP->( dbCloseArea() )
*****
* Only add it if it doesn't exist
*****
IF .NOT. _DICTHDR->(dbSeek(UPPER(pc_DbfName)))
IF _DICTHDR->( VS_AddRec() )
_DICTHDR->DBF_NAME := UPPER(pc_DbfName)
ENDIF
ENDIF
*****
* Delete the old structure (if it exists)
*****
DO WHILE _DICTFLD->( dbSeek(pc_DbfName,.F.) )
IF _DICTFLD->( VS_DelRec() )
_DICTFLD->( dbUnlock() )
ENDIF
ENDDO
FOR n_Cntr = 1 TO LEN(a_Struct_)
IF _DICTFLD->( VS_AddRec() )
_DICTFLD->DBF_NAME := UPPER(pc_DbfName)
_DICTFLD->FIELD_NMBR := STRZERO(n_Cntr*5,3)
_DICTFLD->FIELD_NAME := a_Struct_[n_Cntr,DBS_NAME]
_DICTFLD->FIELD_TYPE := a_Struct_[n_Cntr,DBS_TYPE]
_DICTFLD->FIELD_LEN := a_Struct_[n_Cntr,DBS_LEN]
_DICTFLD->FIELD_DEC := a_Struct_[n_Cntr,DBS_DEC]
ENDIF
NEXT n_Cntr
ENDIF
dbCloseAll()
RETURN(NIL)
*** EOF: PopDict() **********************************************************